home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0987.arc / KAREX.ARC / KAREX3.BAS < prev   
Encoding:
BASIC Source File  |  1980-01-01  |  4.4 KB  |  151 lines
  1. 100 '-------------------------------------------------------
  2. 101 '
  3. 102 '   KAREX3.BAS is a Microsoft BASIC Release 5 program
  4. 103 '   that solves EXAMPLE 3 of the article
  5. 104 '
  6. 105 '              KARMARKAR'S ALGORITHM
  7. 106 '
  8. 107 '      by Andrew M. Rockett and John C. Stevenson
  9. 108 '
  10. 109 '     This program was written by Andrew M. Rockett
  11. 110 '
  12. 111 '-------------------------------------------------------
  13. 200 '
  14. 202 ' N is number of unknowns and K is the number of
  15.       equations
  16. 204 '
  17. 206 N = 8 : K = 4
  18. 208 '
  19. 210 K1 = K + 1 : K2 = 2*K1
  20. 212 DIM A0(N), XOLD(N), XNEW(N), CC(N), CP(N),
  21.     A(K,N), B(K1,N), B1(K1,K2), B2(N,K1), B3(N,N)
  22. 214 FOR C = 1 TO N : A0(C) = 1/N : XNEW(C) = A0(C) : 
  23.     NEXT C
  24. 216 '
  25. 218 ' T is the tolerance
  26. 220 '
  27. 222 T = .001
  28. 224 '
  29. 226 ' ALPHA is usually set equal to 1/4 ...
  30. 228 '
  31. 230 ALPHA = .25
  32. 232 '
  33. 234 ITERATION = 0
  34. 236 '
  35. 238 ' Data for constraint matrix A
  36. 240 '
  37. 242 DATA 1,  0, -1,  0,  0,  0,  3, -3
  38. 244 DATA 1,  0,  0,  1,  0,  0,  0, -2
  39. 246 DATA 0,  1,  0,  0,  1,  0,  3, -5
  40. 248 DATA 0,  1,  0,  0,  0, -1,  4, -4
  41. 250 '
  42. 252 FOR R = 1 TO K : FOR C = 1 TO N : READ A(R,C) : 
  43.     NEXT C : NEXT R
  44. 254 '
  45. 256 ' Data for objective function CC
  46. 258 '
  47. 260 DATA 0,  0,  0,  0,  0,  0,  1,  0
  48. 262 '
  49. 264 FOR C = 1 TO N : READ CC(C) : NEXT C
  50. 266 '
  51. 268 V = 0 : FOR C=1 TO N : V = V + CC(C)*A0(C) :
  52.     NEXT C : VNEW = V
  53. 270 '
  54. 272 ' Main iteration process is the same as in KAREX1.BAS ...
  55. 274 '
  56. 300 WHILE VNEW/V > T
  57. 301 PRINT USING "###";ITERATION;:
  58.     FOR C=1 TO N:PRINT USING "###.####";XNEW(C); : 
  59.     NEXT C :
  60. PRINT USING "####.#######";VNEW/V
  61. 302 ITERATION = ITERATION + 1
  62. 303 FOR C = 1 TO N : XOLD(C) = XNEW(C) : NEXT C
  63. 304 FOR R=1 TO K:FOR C=1 TO N:B(R,C)=A(R,C)*XOLD(C):
  64.     NEXT C:NEXT R
  65. 305 FOR C=1 TO N:B(K1,C)=1:NEXT C
  66. 306 FOR R=1 TO K1 : FOR C=1 TO K2 : B1(R,C)=0 :
  67.     NEXT C : NEXT R
  68. 307 FOR R=1 TO N  : FOR C=1 TO K1 : B2(R,C)=0 :
  69.     NEXT C : NEXT R
  70. 308 FOR R=1 TO N  : FOR C=1 TO N  : B3(R,C)=0 : 
  71.     NEXT C : NEXT R
  72. 309 FOR C=1 TO N  : CP(C) = 0 : NEXT C
  73. 310 FOR R=1 TO K1:FOR C=1 TO K1:
  74.      FOR I=1 TO N:B1(R,C)=B1(R,C)+B(R,I)*B(C,I):
  75.       NEXT I:
  76.     NEXT C:NEXT R
  77. 311 FOR I = 1 TO K1 : B1(I,I+K1)=1 : NEXT I
  78. 312 FOR R = 1 TO K1
  79. 313  IF B1(R,R) <> 0 THEN 318
  80. 314    I = R + 1
  81. 315    IF I > K1 THEN PRINT "Error! BBT is SINGULAR!" :
  82.        GOTO 405
  83. 316    IF B1(I,R) = 0 THEN I = I+1 : GOTO 315
  84. 317    FOR C = 1 TO K2 : SWAP B1(R,C),B1(I,C) : NEXT C
  85. 318  FOR I = R+1 TO K1:Z = B1(I,R)/B1(R,R):
  86.       FOR C=1 TO K2:B1(I,C)=B1(I,C)-Z*B1(R,C):NEXT C:
  87.      NEXT I
  88. 319 NEXT R
  89. 320 FOR R=K1 TO 2 STEP -1:FOR I = R-1 TO 1 STEP -1:Z =
  90.     B1(I,R)/B1(R,R):
  91.      FOR C=R TO K2:B1(I,C)=B1(I,C)-Z*B1(R,C):NEXT C:
  92.     NEXT I:NEXT R
  93. 321 FOR R=1 TO K1:Z = B1(R,R):
  94.      FOR C=1 TO K2:B1(R,C)=B1(R,C)/Z:NEXT C:
  95.     NEXT R
  96. 322 FOR R=1 TO N:FOR C=1 TO K1:
  97.      FOR J=1 TO K1:B2(R,C)=B2(R,C)+B(J,R)*B1(J,C+K1):
  98.       NEXT J:
  99.     NEXT C:NEXT R
  100. 323 FOR R=1 TO N:FOR C=1 TO N:
  101.      FOR J=1 TO K1:B3(R,C)=B3(R,C)+B2(R,J)*B(J,C):
  102.       NEXT J:
  103.     NEXT C:NEXT R
  104. 324 FOR R = 1 TO N : B3(R,R) = B3(R,R) - 1 : NEXT R
  105. 325 FOR R=1 TO N:FOR C=1 TO N:B3(R,C)=-1*B3(R,C):
  106.     NEXT C:NEXT R
  107. 326 FOR R=1 TO N:FOR C=1 TO N:B3(R,C)=B3(R,C)*XOLD(C):
  108.     NEXT C:NEXT R
  109. 327 FOR R=1 TO N:FOR C=1 TO N:CP(R)=CP(R)+B3(R,C)*CC(C):
  110.     NEXT C:NEXT R
  111. 328 AA=0:FOR C=1 TO N : AA = AA + CP(C)*CP(C) : NEXT C
  112. 329 AA = SQR(AA) : FOR C=1 TO N : CP(C) = CP(C)/AA : 
  113.     NEXT C
  114. 330 AA = SQR(N*(N-1))/ALPHA
  115. 331 FOR C=1 TO N : XNEW(C) = (A0(C) - CP(C)/AA)*XOLD(C) :
  116.     NEXT C
  117. 332 AA=0:FOR C=1 TO N : AA = AA + XNEW(C) : NEXT C
  118. 333 FOR C=1 TO N : XNEW(C) = XNEW(C)/AA : NEXT C
  119. 334 VNEW=0:FOR C=1 TO N:VNEW=VNEW+CC(C)*XNEW(C):NEXT C
  120. 335 '
  121. 336 ' FAILURE DETECTION routine based on equation (6) ...
  122. 337 '
  123. 338 ' You may wish to put this routine into KAREX1 and
  124.       KAREX2 to
  125. 339 ' observe the values appearing in (6) during the
  126.       solutions 
  127. 340 ' of EXAMPLEs 1 and 2.
  128. 341 '
  129. 342 AA = 0
  130. 343 FOR C = 1 TO N
  131. 344  IF XNEW(C) > 0 THEN AA = AA + LOG(XNEW(C))
  132. 345 NEXT C
  133. 346 PRINT , LOG(VNEW/V), LOG(N) + AA/N - ITERATION/(8*N)
  134. 347 '
  135. 348 IF LOG(VNEW/V) > LOG(N) + AA/N - ITERATION/(8*N)
  136.     THEN 400
  137. 349 '
  138. 350 WEND
  139. 351 '
  140. 400 PRINT : PRINT "Failure condition has occurred." :
  141.     PRINT
  142. 401 PRINT USING "###"; ITERATION; :
  143.     FOR C=1 TO N:PRINT USING "###.####";XNEW(C); :
  144.     NEXT C :
  145.  PRINT USING "####.#######";VNEW/V
  146. 402 '
  147. 403 PRINT:FOR C=1 TO N-2:PRINT XNEW(C)/XNEW(N), :
  148.     NEXT C:PRINT
  149. 404 '
  150. 405 END
  151.